perm filename DVITYP.POS[WEB,ALS] blob
sn#666057 filedate 1982-07-06 generic text, type T, neo UTF8
{3}{$D-,W+}
PROGRAM Dvitype(dvifile,output);
LABEL
{4}9999;
CONST
{5}maxfonts=100;
maxwidths=10000;
linelength=80;
terminalline=150;
stacksize=100;
namesize=1000;
namelength=50;
TYPE
{7}asciicode=32..126;
{8}textfile=PACKED FILE OF char;
{18}eightbits=0..255;
bytefile=PACKED FILE OF eightbits;
VAR
{9}xord:ARRAY[char]OF asciicode;
xchr:ARRAY[asciicode]OF char;
{19}dvifile:bytefile;
tfmfile:bytefile;
{21}curloc:integer;
curname:PACKED ARRAY[1..namelength]OF char;
{22}b0,b1,b2,b3:eightbits;
{27}fontnum:ARRAY[0..maxfonts]OF integer;
fontname:ARRAY[0..maxfonts]OF 0..namesize;
names:ARRAY[0..namesize]OF asciicode;
fontspace:ARRAY[0..maxfonts]OF integer;
fontbc:ARRAY[0..maxfonts]OF integer;
fontec:ARRAY[0..maxfonts]OF integer;
widthbase:ARRAY[0..maxfonts]OF 0..maxwidths;
width:ARRAY[0..maxwidths]OF integer;
nf:0..maxfonts;
widthptr:0..maxwidths;
{30}inwidth:ARRAY[0:255]OF integer;
tfmchecksum:integer;
{36}pixelwidth:ARRAY[0..maxwidths]OF integer;
conv:real;
{38}outmode:0..2;
maxpages:integer;
resolution:real;
newmag:integer;
{39}startcount:ARRAY[0..9]OF integer;
startthere:ARRAY[0..9]OF boolean;
startvals:0..9;
count:ARRAY[0..9]OF integer;
{42}buffer:ARRAY[0..terminalline]OF asciicode;
{45}bufptr:0..terminalline;
{54}textptr:0..linelength;
textbuf:ARRAY[1..linelength]OF asciicode;
{59}h,v,w,x,y,z,hh,vv:integer;
hstack,vstack,wstack,xstack,ystack,zstack:ARRAY[0..stacksize]OF integer;
hhstack,vvstack:ARRAY[0..stacksize]OF integer;
{60}maxv:integer;
maxh:integer;
maxstackdept:integer;
{63}curfont:integer;
showing:boolean;
{81}pagecount:integer;
pstloc:integer;
startloc:integer;
{83}k,m,n,p,q,r:integer;
{95}defaultdirec:PACKED ARRAY[1:9]OF char;
PROCEDURE Initialize;
VAR
i:integer;
BEGIN
Writeln('This is DVItype, Version 0');
{10}xchr[32]:=' ';
xchr[33]:='!';
xchr[34]:='"';
xchr[35]:='#';
xchr[36]:='$';
xchr[37]:='%';
xchr[38]:='&';
xchr[39]:='''';
xchr[40]:='(';
xchr[41]:=')';
xchr[42]:='*';
xchr[43]:='+';
xchr[44]:=',';
xchr[45]:='-';
xchr[46]:='.';
xchr[47]:='/';
xchr[48]:='0';
xchr[49]:='1';
xchr[50]:='2';
xchr[51]:='3';
xchr[52]:='4';
xchr[53]:='5';
xchr[54]:='6';
xchr[55]:='7';
xchr[56]:='8';
xchr[57]:='9';
xchr[58]:=':';
xchr[59]:=';';
xchr[60]:='<';
xchr[61]:='=';
xchr[62]:='>';
xchr[63]:='?';
xchr[64]:='@';
xchr[65]:='A';
xchr[66]:='B';
xchr[67]:='C';
xchr[68]:='D';
xchr[69]:='E';
xchr[70]:='F';
xchr[71]:='G';
xchr[72]:='H';
xchr[73]:='I';
xchr[74]:='J';
xchr[75]:='K';
xchr[76]:='L';
xchr[77]:='M';
xchr[78]:='N';
xchr[79]:='O';
xchr[80]:='P';
xchr[81]:='Q';
xchr[82]:='R';
xchr[83]:='S';
xchr[84]:='T';
xchr[85]:='U';
xchr[86]:='V';
xchr[87]:='W';
xchr[88]:='X';
xchr[89]:='Y';
xchr[90]:='Z';
xchr[91]:='[';
xchr[92]:='\';
xchr[93]:=']';
xchr[94]:='↑';
xchr[95]:='_';
xchr[96]:='`';
xchr[97]:='a';
xchr[98]:='b';
xchr[99]:='c';
xchr[100]:='d';
xchr[101]:='e';
xchr[102]:='f';
xchr[103]:='g';
xchr[104]:='h';
xchr[105]:='i';
xchr[106]:='j';
xchr[107]:='k';
xchr[108]:='l';
xchr[109]:='m';
xchr[110]:='n';
xchr[111]:='o';
xchr[112]:='p';
xchr[113]:='q';
xchr[114]:='r';
xchr[115]:='s';
xchr[116]:='t';
xchr[117]:='u';
xchr[118]:='v';
xchr[119]:='w';
xchr[120]:='x';
xchr[121]:='y';
xchr[122]:='z';
xchr[123]:='{';
xchr[124]:='|';
xchr[125]:='}';
xchr[126]:='~';
{11}
FOR i:=0 TO 127 DO xord[Chr(i)]:=32;
FOR i:=32 TO 126 DO xord[xchr[i]]:=i;
{28}nf:=0;
widthptr:=0;
fontname[0]:=0;
{40}outmode:=2;
maxpages:=1000000;
startvals:=0;
startthere[0]:=false;
{55}textptr:=0;
{96}defaultdirec:='[TEX,SYS]';
END;
{20}
PROCEDURE Opendvifile;
BEGIN
Reset(dvifile,'','/B:8');
curloc:=0;
END;
PROCEDURE Opentfmfile;
BEGIN
Reset(tfmfile,curname,'/B:8/O/N:19');
END;
{23}
PROCEDURE Readtfmword;
BEGIN
Read(tfmfile,b0);
Read(tfmfile,b1);
Read(tfmfile,b2);
Read(tfmfile,b3);
END;
{24}
FUNCTION Getbyte:integer;
VAR
b:eightbits;
BEGIN
IF Eof(dvifile)THEN
Getbyte:=0
ELSE
BEGIN
Read(dvifile,b);
curloc:=curloc+1;
Getbyte:=b;
END;
END;
FUNCTION Signedbyte:integer;
VAR
b:eightbits;
BEGIN
Read(dvifile,b);
curloc:=curloc+1;
IF b<128 THEN
Signedbyte:=b
ELSE
Signedbyte:=b-256;
END;
FUNCTION Gettwobytes:integer;
VAR
a,b:eightbits;
BEGIN
Read(dvifile,a);
Read(dvifile,b);
curloc:=curloc+2;
Gettwobytes:=a*256+b;
END;
FUNCTION Signedpair:integer;
VAR
a,b:eightbits;
BEGIN
Read(dvifile,a);
Read(dvifile,b);
curloc:=curloc+2;
IF a<128 THEN
Signedpair:=a*256+b
ELSE
Signedpair:=(a-256)*256+b;
END;
FUNCTION Getthreebyte:integer;
VAR
a,b,c:eightbits;
BEGIN
Read(dvifile,a);
Read(dvifile,b);
Read(dvifile,c);
curloc:=curloc+3;
Getthreebyte:=(a*256+b)*256+c;
END;
FUNCTION Signedtrio:integer;
VAR
a,b,c:eightbits;
BEGIN
Read(dvifile,a);
Read(dvifile,b);
Read(dvifile,c);
curloc:=curloc+3;
IF a<128 THEN
Signedtrio:=(a*256+b)*256+c
ELSE
Signedtrio:=((a-256)*256+
b)*256+c;
END;
FUNCTION Signedquad:integer;
VAR
a,b,c,d:eightbits;
BEGIN
Read(dvifile,a);
Read(dvifile,b);
Read(dvifile,c);
Read(dvifile,d);
curloc:=curloc+4;
IF a<128 THEN
Signedquad:=((a*256+b)*256+c)*256+d
ELSE
Signedquad:=(((a
-256)*256+b)*256+c)*256+d;
END;
{25}
FUNCTION Dvilength:integer;
BEGIN
setpos(dvifile,-1);
Dvilength:=curpos(dvifile);
END;
PROCEDURE Movetobyte(n:integer);
BEGIN
setpos(dvifile,n);
curloc:=n;
END;
{29}
PROCEDURE Printfont(f:integer);
VAR
k:0..namesize;
BEGIN
IF f=nf THEN
Write('undefined font!')
ELSE
BEGIN
FOR k:=fontname[f]
TO fontname[f+1]-1 DO Write(xchr[names[k]]);
END;
END;
{31}
FUNCTION Intfm(z:integer):boolean;
LABEL
9997,9998,9999;
VAR
k:integer;
lh:integer;
nw:integer;
wp:0..maxwidths;
alpha,beta:integer;
BEGIN{32}
Readtfmword;
lh:=b2*256+b3;
Readtfmword;
fontbc[nf]:=b0*256+b1;
fontec[nf]:=b2*256+b3;
IF fontec[nf]<fontbc[nf]THEN
fontbc[nf]:=fontec[nf]+1;
IF widthptr+fontec[nf]-fontbc[nf]+1>maxwidths THEN
BEGIN
Writeln(
'---not loaded, DVItype needs larger width table');
GOTO 9998;
END;
wp:=widthptr+fontec[nf]-fontbc[nf]+1;
Readtfmword;
nw:=b0*256+b1;
IF(nw=0)OR(nw>256)THEN
GOTO 9997;
FOR k:=1 TO 3+lh DO
BEGIN
IF Eof(tfmfile)THEN
GOTO 9997;
Readtfmword;
IF k=4 THEN
IF b0<128 THEN
tfmchecksum:=((b0*256+b1)*256+b2)*256+b3
ELSE
tfmchecksum:=(((b0-256)*256+b1)*256+b2)*256+b3;
END;
;
{33}
IF wp>0 THEN
FOR k:=widthptr TO wp-1 DO
BEGIN
Readtfmword;
IF b0>nw THEN
GOTO 9997;
width[k]:=b0;
END;
;
{34}{35}
BEGIN
alpha:=16*z;
beta:=16;
WHILE z>=8388608 DO
BEGIN
z:=z DIV 2;
beta:=beta DIV 2;
END;
END;
FOR k:=0 TO nw-1 DO
BEGIN
Readtfmword;
inwidth[k]:=(((((b3*z)DIV 256)+(b2*z))DIV 256)+(b1*z))DIV beta;
IF b0>0 THEN
IF b0<255 THEN
GOTO 9997
ELSE
inwidth[k]:=inwidth[k]-alpha;
END;
{37}widthbase[nf]:=widthptr-fontbc[nf];
IF wp>0 THEN
FOR k:=widthptr TO wp-1 DO
BEGIN
width[k]:=inwidth[width[k]
];
pixelwidth[k]:=Trunc(conv*(width[k])+0.5);
END;
widthptr:=wp;
Intfm:=true;
GOTO 9999;
9997:
Writeln('---not loaded, TFM file is bad');
9998:
Intfm:=false;
9999:
END;
{41}
FUNCTION Startmatch:boolean;
VAR
k:0..9;
match:boolean;
BEGIN
match:=true;
FOR k:=0 TO startvals DO
IF startthere[k]AND(startcount[k]<>count[k])
THEN
match:=false;
Startmatch:=match;
END;
{44}
PROCEDURE Inputln;
VAR
k:0..terminalline;
BEGIN
Break(tty);
Reset(tty);
IF Eoln(tty)THEN
Readln(tty);
k:=0;
WHILE(k<terminalline)AND NOT Eoln(tty)DO
BEGIN
buffer[k]:=xord[tty↑];
k:=k+1;
Get(tty);
END;
buffer[k]:=32;
END;
{46}
FUNCTION Getinteger:integer;
VAR
x:integer;
negative:boolean;
BEGIN
IF buffer[bufptr]=45 THEN
BEGIN
negative:=true;
bufptr:=bufptr+1;
END
ELSE
negative:=false;
x:=0;
WHILE(buffer[bufptr]>=48)AND(buffer[bufptr]<=57)DO
BEGIN
x:=10*x+buffer[
bufptr]-48;
bufptr:=bufptr+1;
END;
IF negative THEN
Getinteger:=-x
ELSE
Getinteger:=x;
END;
{47}
PROCEDURE Dialog;
LABEL
1,2,3,4,5;
VAR
k:integer;
BEGIN
Rewrite(tty);
{48}1:
Write(tty,'Output level (default=2, ? for help): ');
outmode:=2;
Inputln;
IF buffer[0]<>32 THEN
IF(buffer[0]>=48)AND(buffer[0]<=50)THEN
outmode:=
buffer[0]-48
ELSE
BEGIN
Write(tty,'Type 2 for complete listing,');
Write(tty,' 0 for errors only,');
Writeln(tty,' 1 for something in between.');
GOTO 1;
END;
{49}2:
Write(tty,'Starting page (default=*): ');
startvals:=0;
startthere[0]:=false;
Inputln;
bufptr:=0;
k:=0;
IF buffer[0]<>32 THEN
REPEAT
IF buffer[bufptr]=42 THEN
BEGIN
startthere[
k]:=false;
bufptr:=bufptr+1;
END
ELSE
BEGIN
startthere[k]:=true;
startcount[k]:=Getinteger;
END;
IF(k<9)AND(buffer[bufptr]=46)THEN
BEGIN
k:=k+1;
bufptr:=bufptr+1;
END
ELSE
IF buffer[bufptr]=32 THEN
startvals:=k
ELSE
BEGIN
Write(tty,
'Type, e.g., 1.*.-5 to specify the ');
Writeln(tty,'first page with \count0=1, \count2=-5.');
GOTO 2;
END;
UNTIL startvals=k;
{50}3:
Write(tty,'Maximum number of pages (default=1000000): ');
maxpages:=1000000;
Inputln;
bufptr:=0;
IF buffer[0]<>32 THEN
BEGIN
maxpages:=Getinteger;
IF maxpages<=0 THEN
BEGIN
Writeln(tty,'Please type a positive number.');
GOTO 3;
END;
END;
{51}4:
Write(tty,'Assumed device resolution');
Write(tty,' in pixels per inch (default=240/1): ');
resolution:=240.0;
Inputln;
bufptr:=0;
IF buffer[0]<>32 THEN
BEGIN
k:=Getinteger;
IF(k>0)AND(buffer[bufptr]=47)AND(buffer[bufptr+1]>48)AND(buffer[bufptr+1
]<=57)THEN
BEGIN
bufptr:=bufptr+1;
resolution:=k/Getinteger;
END
ELSE
BEGIN
Write(tty,'Type a ratio of positive integers;');
Writeln(tty,' (1 pixel per mm would be 254/10).');
GOTO 4;
END;
END;
{52}5:
Write(tty,'New magnification (default=0): ');
newmag:=0;
Inputln;
bufptr:=0;
IF buffer[0]<>32 THEN
IF(buffer[0]>=48)AND(buffer[0]<=57)THEN
newmag:=
Getinteger
ELSE
BEGIN
Write(tty,'Type a positive integer to override ');
Writeln(tty,'the magnification in the DVI file.');
GOTO 5;
END;
{53}Writeln('Options selected:');
Write(' Starting page = ');
FOR k:=0 TO startvals DO
BEGIN
IF startthere[k]THEN
Write(startcount[k]:
0)
ELSE
Write('*');
IF k<startvals THEN
Write('.')
ELSE
Writeln(' ');
END;
Writeln(' Maximum number of pages = ',maxpages:0);
Write(' Output level = ',outmode:0);
CASE outmode OF
0:Writeln(' (showing bops and error messages only)');
1:Writeln(' (terse)');
2:Writeln(' (verbose)');
END;
Writeln(' Resolution = ',resolution:12:8,' pixels per inch');
IF newmag>0 THEN
Writeln(' New magnification factor = ',newmag/1000:8:3
);
END;
{56}
PROCEDURE Flushtext;
VAR
k:0..linelength;
BEGIN
IF textptr>0 THEN
BEGIN
IF outmode>0 THEN
BEGIN
Write('[');
FOR k:=1 TO textptr DO Write(xchr[textbuf[k]]);
Writeln(']');
END;
textptr:=0;
END;
END;
{57}
PROCEDURE Outtext(c:asciicode);
BEGIN
IF textptr=linelength-2 THEN
Flushtext;
textptr:=textptr+1;
textbuf[textptr]:=c;
END;
{61}
FUNCTION Firstpar(o:eightbits):integer;
BEGIN
CASE o OF
0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,
22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,
46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,
70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,
94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,
113,114,115,116,117,118,119,120,121,122,123,124,125,126,127:Firstpar:=o
-0;
128,133,235,239:Firstpar:=Getbyte;
129,134,236:Firstpar:=Gettwobytes;
130,135,237:Firstpar:=Getthreebyte;
143,148,153,157,162,167:Firstpar:=Signedbyte;
144,149,154,158,163,168:Firstpar:=Signedpair;
145,150,155,159,164,169:Firstpar:=Signedtrio;
131,132,136,137,146,151,156,160,165,170,238:Firstpar:=Signedquad;
138,139,140,141,142,240,241,242,243,244,245,246,247,248,249,250,251,252,
253,254,255:Firstpar:=0;
147:Firstpar:=w;
152:Firstpar:=x;
161:Firstpar:=y;
166:Firstpar:=z;
171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,
189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,
207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,
225,226,227,228,229,230,231,232,233,234:Firstpar:=o-171;
END;
END;
{62}
FUNCTION Rulepixels(x:integer):integer;
VAR
n:integer;
BEGIN
n:=Trunc(conv*x);
IF n<conv*x THEN
Rulepixels:=n+1
ELSE
Rulepixels:=n;
END;
{65}
FUNCTION Doothers(o:eightbits;
p:integer;
a:integer):boolean;
LABEL
44,9998,30;
VAR
q:integer;
BEGIN{69}
CASE o OF
133,134,135,136:BEGIN
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','put',o-132:0,' ',p:0);
END;
GOTO 30;
END;
{72}157,158,159,160:BEGIN
IF Abs(p)>=5*fontspace[curfont]THEN
vv:=Trunc(
conv*(v+p)+0.5)
ELSE
vv:=vv+Trunc(conv*(p)+0.5);
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','down',o-156:0,' ',p:0);
END;
GOTO 44;
END;
161,162,163,164,165:BEGIN
y:=p;
IF Abs(p)>=5*fontspace[curfont]THEN
vv:=Trunc(conv*(v+p)+0.5)
ELSE
vv:=vv
+Trunc(conv*(p)+0.5);
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','y',o-161:0,' ',p:0);
END;
GOTO 44;
END;
166,167,168,169,170:BEGIN
z:=p;
IF Abs(p)>=5*fontspace[curfont]THEN
vv:=Trunc(conv*(v+p)+0.5)
ELSE
vv:=vv
+Trunc(conv*(p)+0.5);
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','z',o-166:0,' ',p:0);
END;
GOTO 44;
END;
240:BEGIN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','pst occurred before eop');
END
ELSE
Write(' ','pst occurred before eop');
GOTO 9998;
END;
241,242,243,244,245,246,247,248,249,250,251,252,253,254,255:BEGIN
IF NOT
showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','undefined command ',o:0,'!');
END
ELSE
Write(' ','undefined command ',o:0,'!');
GOTO 30;
END;
END;
44:{78}
IF(v>0)AND(p>0)THEN
IF v>2147483647-p THEN
BEGIN
IF NOT showing
THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','arithmetic overflow! parameter changed from ',p:0,' to '
,2147483647-v:0);
END
ELSE
Write(' ','arithmetic overflow! parameter changed from ',p:0,
' to ',2147483647-v:0);
p:=2147483647-v;
END;
IF(v<0)AND(p<0)THEN
IF-v>p+2147483647 THEN
BEGIN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','arithmetic overflow! parameter changed from ',p:0,' to '
,(-v)-2147483647:0);
END
ELSE
Write(' ','arithmetic overflow! parameter changed from ',p:0,
' to ',(-v)-2147483647:0);
p:=(-v)-2147483647;
END;
IF showing THEN
BEGIN
Write(' v:=',v:0);
IF p>=0 THEN
Write('+');
Write(p:0,'=',v+p:0,', vv:=',vv:0);
END;
v:=v+p;
IF Abs(v)>maxv THEN
BEGIN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','warning: |v|>',maxv:0,'!');
END
ELSE
Write(' ','warning: |v|>',maxv:0,'!');
maxv:=Abs(v);
END;
GOTO 30;
9998:
Doothers:=false;
30:
END;
{66}
FUNCTION Dopage:boolean;
LABEL
41,42,43,45,46,30,9998,9999;
VAR
o:eightbits;
p,q:integer;
a:integer;
s:integer;
ss:integer;
k:integer;
badchar:boolean;
BEGIN
curfont:=nf;
s:=0;
h:=0;
v:=0;
w:=0;
x:=0;
y:=0;
z:=0;
hh:=0;
vv:=0;
WHILE true DO{67}
BEGIN
a:=curloc;
showing:=false;
o:=Getbyte;
p:=Firstpar(o);
{68}
IF o<128 THEN
{74}
BEGIN
IF(o>32)AND(o<=126)THEN
BEGIN
Outtext(p);
IF outmode=2 THEN
BEGIN
showing:=true;
Write(a:0,': ','setchar',p:0);
END;
END
ELSE
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','setchar',p:0);
END;
GOTO 41;
END
ELSE
CASE o OF
128,129,130,131:BEGIN
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','set',o-127:0,' ',p:0);
END;
GOTO 41;
END;
132:BEGIN
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','setrule');
END;
GOTO 42;
END;
137:BEGIN
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','putrule');
END;
GOTO 42;
END;
{70}138:BEGIN
IF outmode=2 THEN
BEGIN
showing:=true;
Write(a:0,': ','nop');
END;
GOTO 30;
END;
139:BEGIN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','bop occurred before eop');
END
ELSE
Write(' ','bop occurred before eop');
GOTO 9998;
END;
140:BEGIN
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','eop');
END;
IF s<>0 THEN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','stack not empty at end of page (level ',s:0,')!');
END
ELSE
Write(' ','stack not empty at end of page (level ',s:0,')!');
Dopage:=true;
GOTO 9999;
END;
141:BEGIN
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','push');
END;
IF s=maxstackdept THEN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','deeper than claimed in postamble!');
END
ELSE
Write(' ','deeper than claimed in postamble!');
IF s=stacksize THEN
BEGIN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','DVItype capacity exceeded (stack size=',stacksize:0,')')
;
END
ELSE
Write(' ','DVItype capacity exceeded (stack size=',stacksize:0,
')');
GOTO 9998;
END;
hstack[s]:=h;
vstack[s]:=v;
wstack[s]:=w;
xstack[s]:=x;
ystack[s]:=y;
zstack[s]:=z;
hhstack[s]:=hh;
vvstack[s]:=vv;
s:=s+1;
ss:=s-1;
GOTO 45;
END;
142:BEGIN
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','pop');
END;
IF s=0 THEN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','(illegal at level zero)!');
END
ELSE
Write(' ','(illegal at level zero)!')
ELSE
BEGIN
s:=s-1;
hh:=hhstack[s];
vv:=vvstack[s];
h:=hstack[s];
v:=vstack[s];
w:=wstack[s];
x:=xstack[s];
y:=ystack[s];
z:=zstack[s];
END;
ss:=s;
GOTO 45;
END;
{71}143,144,145,146:BEGIN
IF Abs(p)>=fontspace[curfont]THEN
BEGIN
Outtext(32);
hh:=Trunc(conv*(h+p)+0.5);
END
ELSE
hh:=hh+Trunc(conv*(p)+0.5);
IF outmode=2 THEN
BEGIN
showing:=true;
Write(a:0,': ','right',o-142:0,' ',p:0);
END;
q:=p;
GOTO 43;
END;
147,148,149,150,151:BEGIN
w:=p;
IF Abs(p)>=fontspace[curfont]THEN
BEGIN
Outtext(32);
hh:=Trunc(conv*(h+p)+0.5);
END
ELSE
hh:=hh+Trunc(conv*(p)+0.5);
IF outmode=2 THEN
BEGIN
showing:=true;
Write(a:0,': ','w',o-147:0,' ',p:0);
END;
q:=p;
GOTO 43;
END;
152,153,154,155,156:BEGIN
x:=p;
IF Abs(p)>=fontspace[curfont]THEN
BEGIN
Outtext(32);
hh:=Trunc(conv*(h+p)+0.5);
END
ELSE
hh:=hh+Trunc(conv*(p)+0.5);
IF outmode=2 THEN
BEGIN
showing:=true;
Write(a:0,': ','x',o-152:0,' ',p:0);
END;
q:=p;
GOTO 43;
END;
171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,
189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,
207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,
225,226,227,228,229,230,231,232,233,234:BEGIN
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','fntnum',p:0);
END;
GOTO 46;
END;
235,236,237,238:BEGIN
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','fnt',o-234:0,' ',p:0);
END;
GOTO 46;
END;
239:{73}BEGIN
IF outmode>0 THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','xxx''');
END;
badchar:=false;
FOR k:=1 TO p DO
BEGIN
q:=Getbyte;
IF(q>=33)AND(q<=126)THEN
BEGIN
IF showing THEN
Write(xchr[q]);
END
ELSE
badchar:=true;
END;
IF showing THEN
Write('''');
IF badchar THEN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','non-ascii character in xxx command!');
END
ELSE
Write(' ','non-ascii character in xxx command!');
END;
OTHERS:IF Doothers(o,p,a)THEN
GOTO 30
ELSE
GOTO 9998;
END;
41:{75}
IF fontec[curfont]=256 THEN
p:=256;
IF(p<fontbc[curfont])OR(p>fontec[curfont])THEN
q:=2147483647
ELSE
q:=
width[widthbase[curfont]+p];
IF q=2147483647 THEN
BEGIN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','character ',p:0,' invalid in font ');
END
ELSE
Write(' ','character ',p:0,' invalid in font ');
Printfont(curfont);
IF curfont<>nf THEN
Write('!');
END;
IF o>=133 THEN
GOTO 30;
IF q=2147483647 THEN
q:=0
ELSE
hh:=hh+pixelwidth[widthbase[curfont]+p];
GOTO 43;
42:{76}
q:=Signedquad;
IF showing THEN
BEGIN
Write(' height ',p:0,', width ',q:0);
IF(p<=0)OR(q<=0)THEN
Write(' (invisible)')
ELSE
Write(' (',Rulepixels(p):
0,'x',Rulepixels(q):0,' pixels)');
END;
IF o=137 THEN
GOTO 30;
hh:=hh+Rulepixels(q);
GOTO 43;
43:{77}
IF(h>0)AND(q>0)THEN
IF h>2147483647-q THEN
BEGIN
IF NOT showing
THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','arithmetic overflow! parameter changed from ',q:0,' to '
,2147483647-h:0);
END
ELSE
Write(' ','arithmetic overflow! parameter changed from ',q:0,
' to ',2147483647-h:0);
q:=2147483647-h;
END;
IF(h<0)AND(q<0)THEN
IF-h>q+2147483647 THEN
BEGIN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','arithmetic overflow! parameter changed from ',q:0,' to '
,(-h)-2147483647:0);
END
ELSE
Write(' ','arithmetic overflow! parameter changed from ',q:0,
' to ',(-h)-2147483647:0);
q:=(-h)-2147483647;
END;
IF showing THEN
BEGIN
Write(' h:=',h:0);
IF q>=0 THEN
Write('+');
Write(q:0,'=',h+q:0,', hh:=',hh:0);
END;
h:=h+q;
IF Abs(h)>maxh THEN
BEGIN
IF NOT showing THEN
BEGIN
Flushtext;
showing:=true;
Write(a:0,': ','warning: |h|>',maxh:0,'!');
END
ELSE
Write(' ','warning: |h|>',maxh:0,'!');
maxh:=Abs(h);
END;
GOTO 30;
45:{79}
IF showing THEN
BEGIN
Writeln(' ');
Write('level ',ss:0,':(h=',h:0,',v=',v:0,',w=',w:0,',x=',x:0,',y=',y:0,
',z=',z:0,',hh=',hh:0,',vv=',vv:0,')');
END;
GOTO 30;
46:{80}
fontnum[nf]:=p;
curfont:=0;
WHILE fontnum[curfont]<>p DO curfont:=curfont+1;
IF showing THEN
BEGIN
Write(' current font is ');
Printfont(curfont);
END;
30:
IF showing THEN
Writeln(' ');
END;
9998:
Writeln('!');
Dopage:=false;
9999:
END;
{100}
BEGIN
Initialize;
Dialog;
{84}Opendvifile;
pstloc:=-1;
startloc:=-1;
pagecount:=0;
IF true THEN
BEGIN{85}
n:=Dvilength;
IF n<42 THEN
BEGIN
Write(' ','Bad DVI file: ','only ',n:0,' bytes long',
'!');
GOTO 9999;
END;
m:=n-4;
REPEAT
IF m=0 THEN
BEGIN
Write(' ','Bad DVI file: ','all 223s','!');
GOTO 9999;
END;
Movetobyte(m);
k:=Getbyte;
m:=m-1;
UNTIL k<>223;
IF k<>2 THEN
BEGIN
Write(' ','Bad DVI file: ','ID byte is ',k:0,'!');
GOTO 9999;
END;
Movetobyte(m-3);
q:=Signedquad;
IF(q<0)OR(q>m-36)THEN
BEGIN
Write(' ','Bad DVI file: ','pst pointer ',q:
0,' at byte ',m-3:0,'!');
GOTO 9999;
END;
Movetobyte(q);
k:=Getbyte;
IF k<>240 THEN
BEGIN
Write(' ','Bad DVI file: ','byte ',q:0,
' is not pst','!');
GOTO 9999;
END;
pstloc:=q;
{86}
REPEAT
p:=Signedquad;
IF(p>q-46)AND(p>=0)THEN
BEGIN
Write(' ','Bad DVI file: ','page link ',p:
0,' after byte ',q:0,'!');
GOTO 9999;
END;
IF p>=0 THEN
BEGIN
q:=p;
Movetobyte(q);
k:=Getbyte;
IF k=139 THEN
pagecount:=pagecount+1
ELSE
BEGIN
Write(' ',
'Bad DVI file: ','byte ',q:0,' is not bop','!');
GOTO 9999;
END;
FOR k:=0 TO 9 DO count[k]:=Signedquad;
IF Startmatch THEN
startloc:=q;
END
ELSE
IF q>0 THEN
BEGIN
Movetobyte(0);
WHILE curloc<q DO
BEGIN
k:=Getbyte;
IF k<>138 THEN
BEGIN
Write(' ','Bad DVI file: ','byte ',curloc-1:0,
' is not nop','!');
GOTO 9999;
END;
END;
END;
UNTIL p<0;
Movetobyte(pstloc+5);
END
ELSE
BEGIN{87}
REPEAT
IF Eof(dvifile)THEN
k:=0
ELSE
k:=Getbyte;
UNTIL k<>138;
IF(k<>139)AND(k<>240)THEN
BEGIN
Write(' ','Bad DVI file: ',
'first non-nop byte is ',k:0,'!');
GOTO 9999;
END;
p:=-1;
WHILE pstloc<0 DO
BEGIN
m:=Firstpar(k);
IF k=139 THEN
{88}
BEGIN
pagecount:=pagecount+1;
FOR k:=0 TO 9 DO count[k]:=Signedquad;
IF(startloc<0)AND Startmatch THEN
startloc:=curloc-41;
{89}
BEGIN
k:=Signedquad;
IF k<>p THEN
BEGIN
Write(' ','Bad DVI file: ','backpointer in byte ',
curloc-4:0,' should be ',p:0,'!');
GOTO 9999;
END;
END;
p:=curloc-45;
END
ELSE
IF(k=132)OR(k=137)THEN
m:=Signedquad
ELSE
IF k=240 THEN
pstloc
:=curloc-1
ELSE
IF k=239 THEN
FOR k:=1 TO m DO n:=Getbyte;
IF Eof(dvifile)THEN
BEGIN
Write(' ','Bad DVI file: ',
'postamble unfindable','!');
GOTO 9999;
END;
IF pstloc<0 THEN
k:=Getbyte;
END;
{89}
BEGIN
k:=Signedquad;
IF k<>p THEN
BEGIN
Write(' ','Bad DVI file: ','backpointer in byte ',
curloc-4:0,' should be ',p:0,'!');
GOTO 9999;
END;
END;
END;
{90}
BEGIN
Writeln('Postamble starts at byte ',pstloc:0,'.');
{91}n:=Signedquad;
m:=Signedquad;
IF n<=0 THEN
BEGIN
Write(' ','Bad DVI file: ','numerator is ',n:0,'!');
GOTO 9999;
END;
IF m<=0 THEN
BEGIN
Write(' ','Bad DVI file: ','denominator is ',m:0,'!')
;
GOTO 9999;
END;
Writeln('numerator/denominator=',n:0,'/',m:0);
conv:=(n/254000.0)*(resolution/m);
n:=Signedquad;
IF newmag>0 THEN
n:=newmag
ELSE
IF n<=0 THEN
BEGIN
Write(' ',
'Bad DVI file: ','magnification is ',n:0,'!');
GOTO 9999;
END;
conv:=conv*(n/1000.0);
Writeln('magnification=',n:0,'; ',conv:16:8,' pixels per DVI unit');
maxv:=Signedquad;
maxh:=Signedquad;
maxstackdept:=Gettwobytes;
Write('maxv=',maxv:0,', maxh=',maxh:0,', maxstackdepth=',maxstackdept:0)
;
m:=Gettwobytes;
Write(', totalpages=',m:0);
IF m=pagecount THEN
Writeln(' ')
ELSE
Writeln(' (should be',pagecount:0,
'!)');
{93}fontnum[nf]:=Signedquad;
WHILE fontnum[nf]<>-1 DO
BEGIN
IF Eof(dvifile)THEN
BEGIN
Write(' ',
'Bad DVI file: ','endless font definitions','!');
GOTO 9999;
END;
IF nf=maxfonts THEN
BEGIN
Write(' ',
'DVItype capacity exceeded (max fonts=',maxfonts:0,')!');
GOTO 9999;
END;
Write('Font ',fontnum[nf]:0,': ');
m:=Signedquad;
q:=Signedquad;
{94}p:=Getbyte;
n:=Getbyte;
IF fontname[nf]+n+p>namesize THEN
BEGIN
Write(' ',
'DVItype capacity exceeded (name size=',namesize:0,')!');
GOTO 9999;
END;
IF n+p=0 THEN
BEGIN
Write(' ','Bad DVI file: ','null font name','!');
GOTO 9999;
END;
fontname[nf+1]:=fontname[nf]+n+p;
FOR k:=fontname[nf]TO fontname[nf+1]-1 DO
BEGIN
r:=Getbyte;
IF(r<32)OR(r>126)THEN
names[k]:=63
ELSE
names[k]:=r;
END;
nf:=nf+1;
Printfont(nf-1);
nf:=nf-1;
{97}
FOR k:=1 TO namelength DO curname[k]:=' ';
r:=0;
FOR k:=fontname[nf]+p TO fontname[nf+1]-1 DO
BEGIN
r:=r+1;
IF r+4>namelength THEN
BEGIN
Write(' ','Font name is too long!');
GOTO 9999;
END;
IF(names[k]>=97)AND(names[k]<=122)THEN
curname[r]:=xchr[names[k]-32]
ELSE
curname[r]:=xchr[names[k]];
END;
curname[r+1]:='.';
curname[r+2]:='T';
curname[r+3]:='F';
curname[r+4]:='M';
r:=r+4;
IF p=0 THEN
FOR k:=1 TO 9 DO
BEGIN
r:=r+1;
IF r>namelength THEN
BEGIN
Write(' ','Font name is too long!');
GOTO 9999;
END;
curname[r]:=defaultdirec[k];
END
ELSE
FOR k:=fontname[nf]TO fontname[nf]+p-1 DO
BEGIN
r:=r+1;
IF r>namelength THEN
BEGIN
Write(' ','Font name is too long!');
GOTO 9999;
END;
IF(names[k]>=97)AND(names[k]<=122)THEN
curname[r]:=xchr[names[k]-32]
ELSE
curname[r]:=xchr[names[k]];
END;
{98}k:=0;
WHILE fontnum[k]<>fontnum[nf]DO k:=k+1;
IF k<nf THEN
Writeln('---not loaded, this number already used!')
ELSE
BEGIN
Opentfmfile;
IF Eof(tfmfile)THEN
Writeln('---not loaded, TFM file can''t be opened!')
ELSE
BEGIN
IF(q<=0)OR(q>=134217728)THEN
Writeln(
'---not loaded, bad scale (',q:0,')!')
ELSE
IF Intfm(q)THEN
{99}
BEGIN
fontspace[nf]:=q DIV 6;
IF(m<>0)AND(tfmchecksum<>0)AND(m<>tfmchecksum)THEN
BEGIN
Writeln(
'---loaded but beware: check sums do not agree!');
Writeln(' (',m:0,' vs. ',tfmchecksum:0,')');
END
ELSE
Writeln('---loaded at size ',q:0,' DVI units');
nf:=nf+1;
END;
END;
END;
fontnum[nf]:=Signedquad;
END;
{92}q:=Signedquad;
IF q<>pstloc THEN
Writeln('pst pointer in byte ',curloc-4:0,
' should be ',pstloc:0,'!');
m:=Getbyte;
IF m<>2 THEN
Writeln('identification in byte ',curloc-1:0,' should be ',
2:0,'!');
k:=curloc;
m:=223;
WHILE(m=223)AND NOT Eof(dvifile)DO m:=Getbyte;
IF NOT Eof(dvifile)THEN
Writeln('signature in byte ',curloc-1:0,
' should be 223!')
ELSE
IF curloc<k+4 THEN
Writeln(
'not enough signature bytes at end of file (',curloc-k:0,')');
;
END;
IF startloc<0 THEN
Writeln('The starting page could not be found!')
ELSE
BEGIN
IF true THEN
Movetobyte(startloc)
ELSE
BEGIN
Opendvifile;
WHILE curloc<startloc DO n:=Getbyte;
END;
{101}
WHILE maxpages>0 DO
BEGIN
maxpages:=maxpages-1;
REPEAT
k:=Getbyte;
UNTIL k<>138;
IF k=240 THEN
GOTO 9999;
IF k<>139 THEN
BEGIN
Write(' ','Bad DVI file: ','command at byte ',
curloc-1:0,' is not bop','!');
GOTO 9999;
END;
Writeln(' ');
Write(curloc-1:0,': beginning of page ');
FOR k:=0 TO startvals DO
BEGIN
Write(Signedquad:0);
IF k<startvals THEN
Write('.')
ELSE
Writeln(' ');
END;
FOR k:=startvals+1 TO 10 DO n:=Signedquad;
IF NOT Dopage THEN
BEGIN
Write(' ','page ended unexpectedly!');
GOTO 9999;
END;
END;
END;
9999:
END.